home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / ratbas.arc / TEST.BAS < prev    next >
Encoding:
BASIC Source File  |  1982-11-05  |  5.5 KB  |  167 lines
  1.  105    ' ********* BASIC version of RatBas program ********** 
  2.  110     DefInt i-n 
  3.  115   ' TEST  Program to test RT Translator
  4.  120   '
  5.  125   DIM Names$(200)
  6.  130   '
  7.  135   Maxnames=200
  8.  140   ' Include File Sort.inc
  9.  145    GO TO 25000 ' jump to program 
  10.  200    '----------------------- PROCEDURE SORT
  11.  205     ' Shell Sort
  12.  210   '  global variables   numnames  number of names to be sorted
  13.  215   '                     names$    names to be sorted
  14.  220      jump.sort=numnames
  15.  225      while jump.sort>0
  16.  230         jump.sort=jump.sort\2
  17.  235         limit.sort=numnames-jump.sort
  18.  240         lower.sort=1
  19.  245         while lower.sort<=limit.sort
  20.  250            ibottom.sort=lower.sort
  21.  255            more.sort=true
  22.  260            while ibottom.sort>0 and more.sort
  23.  265               itop.sort=ibottom.sort+jump.sort
  24.  270               IF NAMES$(IBOTTOM.SORT)>NAMES$(ITOP.SORT)  THEN ELSE GO TO  290
  25.  275                  swap names$(ibottom.sort), names$(itop.sort)
  26.  280                  ibottom.sort=ibottom.sort-jump.sort
  27.  285    GO TO   300
  28.  290    ' ELSE] 
  29.  295                  more.sort=false
  30.  300                ' IFEnd] 
  31.  305            wend
  32.  310            lower.sort=lower.sort+1
  33.  315         wend
  34.  320      wend
  35.  325    RETURN ' ------------------------------------------
  36.  330   '
  37.  400    '----------------------- PROCEDURE GETKEY
  38.  405      for i.getkey=1 to 10: fromuser$=inkey$: next
  39.  410      while fromuser$="": fromuser$=inkey$: wend
  40.  415    RETURN ' ------------------------------------------
  41.  420   '
  42.  500    '----------------------- PROCEDURE  GETSELECTION
  43.  505   cls
  44.  510   print "Menu For Sort Program
  45.  515   print
  46.  520   print "1   Enter a List of Names from Keyboard"
  47.  525   print "2   Display the Names"
  48.  530   print "3   Read a list of Names from a disk file"
  49.  535   print "4   Write the list of Names to a disk file"
  50.  540   print "5   Sort the Names alphabetically"
  51.  545   print "10  End the Program
  52.  550   print
  53.  555   print "Strike Function Key for your choice"
  54.  560   choicemade%=false
  55.  565   while not choicemade%
  56.  570    GOSUB  400 ' GETKEY
  57.  575     IF LEN(FROMUSER$)=2  THEN ELSE GO TO  590
  58.  580        ifunc.get=asc(mid$(fromuser$,2,1))-58
  59.  585    GO TO   600
  60.  590    ' ELSE] 
  61.  595        ifunc.get=0
  62.  600      ' IFEnd] 
  63.  605     choicemade%=ifunc.get=10 or (ifunc.get>=1 and ifunc.get<=5)
  64.  610   wend
  65.  615    RETURN ' ------------------------------------------
  66.  620   '
  67.  700    '----------------------- PROCEDURE ENTERNAMES
  68.  705   cls
  69.  710   locate 25,1
  70.  715   Print "Enter Names.  Use a Null Line to quit";
  71.  720   locate 1,1,1
  72.  725   numnames=0
  73.  730   line input namein$
  74.  735   while namein$<>"" and numnames<maxnames
  75.  740      numnames=numnames+1
  76.  745      names$(numnames)=namein$
  77.  750      line input namein$
  78.  755   wend
  79.  760    RETURN ' ------------------------------------------
  80.  765   '
  81.  800    '----------------------- PROCEDURE DISPLAYNAMES
  82.  805   for j=1 to numnames step 20
  83.  810      klast=j+19: if klast>numnames then klast=numnames
  84.  815      cls
  85.  820      for k=j to klast
  86.  825         Print names$(k)
  87.  830      next k
  88.  835      print
  89.  840      print "Press Space Bar to Continue;
  90.  845    GOSUB  400 ' GETKEY
  91.  850   next j
  92.  855    RETURN ' ------------------------------------------
  93.  860   '
  94.  900    '----------------------- PROCEDURE READNAMES
  95.  905   cls
  96.  910   numnames=0
  97.  915   print
  98.  920   Input "Enter Name of File with input ";file$
  99.  925   Open file$ for input as #1
  100.  930   while not eof(1) and numnames<maxnames
  101.  935      line input #1, namein$
  102.  940      numnames=numnames+1
  103.  945      names$(numnames)=namein$
  104.  950      print ".";
  105.  955   wend
  106.  960   close #1
  107.  965    RETURN ' ------------------------------------------
  108.  970   '
  109.  1000    '----------------------- PROCEDURE WRITENAMES
  110.  1005   cls
  111.  1010   print
  112.  1015   Input "Enter Name of File to write names";file$
  113.  1020   Open file$ for output as #1
  114.  1025   for j=1 to numnames
  115.  1030      Print #1, names$(j)
  116.  1035      print ".";
  117.  1040   next j
  118.  1045   close #1
  119.  1050    RETURN ' ------------------------------------------
  120.  1055   '
  121.  25000    ' =================== PROCEDURE LOCATIONS ===========
  122.  25005    '  200 SORT
  123.  25010    '  400 GETKEY
  124.  25015    '  500 GETSELECTION
  125.  25020    '  700 ENTERNAMES
  126.  25025    '  800 DISPLAYNAMES
  127.  25030    '  900 READNAMES
  128.  25035    '  1000 WRITENAMES
  129.  25040    ' ================== PROGRAM ======================== 
  130.  25045    false = 0: true = not false 
  131.  25050   key off
  132.  25055   for k=1 to 10
  133.  25060      key k,""
  134.  25065   next k
  135.  25070   cls
  136.  25075   Print "Program to Sort a List of Names"
  137.  25080   IFUNC.GET=CHOICE
  138.  25085   GOSUB  500 ' GETSELECTION
  139.  25090   CHOICE=IFUNC.GET
  140.  25095   while choice<10
  141.  25100    ' CASE  CHOICE  OF
  142.  25105    IF ( CHOICE =1 )  THEN ELSE GO TO   25120
  143.  25110    GOSUB  700 ' ENTERNAMES
  144.  25115    GO TO   25185
  145.  25120    IF ( CHOICE =2 )  THEN ELSE GO TO   25135
  146.  25125    GOSUB  800 ' DISPLAYNAMES
  147.  25130    GO TO   25185
  148.  25135    IF ( CHOICE =3 )  THEN ELSE GO TO   25150
  149.  25140    GOSUB  900 ' READNAMES
  150.  25145    GO TO   25185
  151.  25150    IF ( CHOICE =4 )  THEN ELSE GO TO   25165
  152.  25155    GOSUB  1000 ' WRITENAMES
  153.  25160    GO TO   25185
  154.  25165    IF ( CHOICE =5 )  THEN ELSE GO TO   25180
  155.  25170    GOSUB  200 ' SORT
  156.  25175    GO TO   25185
  157.  25180    ' OTHERWISE 
  158.  25185    ' CEND
  159.  25190   IFUNC.GET=CHOICE
  160.  25195    GOSUB  500 ' GETSELECTION
  161.  25200   CHOICE=IFUNC.GET
  162.  25205   wend
  163.  25210   END
  164.  CEND
  165.  25190   IFUNC.GET=CHOICE
  166.  25195    GOSUB  500 ' GETSELECTION
  167.